home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Night Owl 6
/
Night Owl's Shareware - PDSI-006 - Night Owl Corp (1990).iso
/
008a
/
paragen2.zip
/
VIDLIB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-03-28
|
26KB
|
1,040 lines
{$N+,F+}
PROGRAM VIDLIb;
USES
Crt,Pxengine,Vidutil,Vlib;
TYPE
FExecute = Function:Integer;
PROCESS= Record
Item : String[2];
Message : String;
FPtr: FExecute;
End;
CONST
NumKeys : Integer = 0;
FieldNum : Integer = 0;
GotSrchKFirst : Boolean = FALSE;
GotSrchFFirst : Boolean = FALSE;
VAR
SearchRecord : VLIBTABLEENTRY;
Choice : String;
Key : Char;
FUNCTION VLIBError1(ErrCode : Integer) : Integer;
Var
Key : Char;
ClrString : String;
BEGIN
Fillchar(ClrString,sizeof(ClrString),' ');
ClrString[0] := #70;
if (ErrCode > 0) then
Begin
GoToRc(24,6);
Write('[Err:',ErrCode,'] ',PXErrMsg(ErrCode),' (Hit any Key)');
VLIBError1 := ErrCode;
Key := ReadKey;
PrintText(24,6,ClrString);
End
else
VLIBError1 := PXSUCCESS;
END;
PROCEDURE DisplayFields;
Begin
PrintText(4,3, '1-Title...:');
PrintText(4,62,'2-Rating..:');
PrintText(5,3, '3-Star(s).:');
PrintText(6,3, '4-Cast....:');
PrintText(6,48,'5-Director:');
PrintText(7,3, '6-Company.:');
PrintText(7,33,'7-Category:');
PrintText(7,59,'8-Date.:');
PrintText(9,3, '9-Price:$');
PrintText(9,23,'10-Tape #:');
PrintText(9,40,'11-Run Time:');
PrintText(9,60,'12-Format:');
PrintText(10,3,'13-Start:');
PrintText(10,23,'14-Stop.:');
PrintText(10,40,'15-Rec Speed:');
PrintText(13,5, 'AR-Add Record');
PrintText(14,5, 'CT-Close Table');
PrintText(15,5, 'DT-Decrypt Table');
PrintText(16,5, 'DR-Delete Record');
PrintText(17,5, 'ET-Delete Table');
PrintText(18,5, 'ER-Edit Record');
PrintText(13,23,'FR-First Record');
PrintText(14,23,'GR-Goto Record');
PrintText(15,23,'KF-Srch Key 1st');
PrintText(16,23,'KN-Srch Key Next');
PrintText(17,23,'LR-Last Record');
PrintText(18,23,'MT-Merge Table');
PrintText(13,41,'NT-Encrypt Table');
PrintText(14,41,'NR-Next Record');
PrintText(15,41,'OT-Open Table');
PrintText(16,41,'PF-Copy Table');
PrintText(17,41,'PR-Prev Record');
PrintText(18,41,'QU-Quit');
PrintText(13,59,'RT-Rename Table');
PrintText(14,59,'SF-Srch Field 1st');
PrintText(15,59,'SN-Srch Field Next');
PrintText(16,59,'TT-Create Table');
PrintText(17,59,'YT-Empty Table');
PrintText(18,58, '[Choice: ]');
PrintText(21,2,'File: None');
PrintText(21,20,'Records: 0');
PrintText(21,35,'Fields: 0');
PrintText(21,49,'Key Fields: 0');
PrintText(21,66,'Rec No: 0');
End;
FUNCTION OpeningScreen: Boolean;
Begin
OpeningScreen := TRUE;
ClearArea(1,1,25,80);
CenterText(1,1,80,'PARAGen-Video Library Demo..[Pascal Ver 1.4]');
CenterText(2,1,80,'(C) 90,91 Innovative Data Solutions, Inc.');
DrawBox(3,1,13,80,'╡Video Data╞');
DrawBox(12,4,8,74,'╡Options╞');
DrawBox(20,1,3,80,'╡Paradox Information');
DrawBox(22,4,4,74,'╡Error and Input Information╞');
DisplayFields;
VLIBRet := PXinit;
if (VLIBRet <> PXSUCCESS) then
Begin
VlibRet := VLIBError1(VlibRet);
OPeningScreen := FALSE;
End;
End;
Procedure ClearRecord;
Type
IType = Array[0..14] of Byte;
Const
CRow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
CCol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
Len:IType = (40,5,55,30,15,15,10,10,7,5,7,8,7,7,10);
Number:Byte = 14;
Var
Index : Byte;
Spaces,TempString : String;
Begin
FillChar(Spaces,sizeof(Spaces),' ');
FillChar(TempString,sizeof(TempString),#0);
Spaces[0] := #80;
TempString[0] := #0;
For Index := 0 to Number do
Begin
TempString := Copy(Spaces,1,Len[Index]);
PrintText(CRow[Index],CCol[Index],TempString);
End;
End;
Procedure DisplayRecord(RecordEntry:VLIBTABLEENTRY);
Type
IType = Array[0..14] of Byte;
Const
DRow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
DCol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
Begin
ClearRecord;
PrintText(DRow[0],DCol[0],RecordEntry.Title);
PrintText(DRow[1],DCol[1],RecordEntry.Rating);
PrintText(DRow[2],DCol[2],RecordEntry.Stars);
PrintText(DRow[3],DCol[3],RecordEntry.Cast);
PrintText(DRow[4],DCol[4],RecordEntry.Director);
PrintText(DRow[5],DCol[5],RecordEntry.Company);
PrintText(DRow[6],DCol[6],RecordEntry.Category);
GoToRC(DRow[7],DCol[7]);
Write(RecordEntry.DateMonth:2,'/',RecordEntry.DateDay:2,'/',(RecordEntry.DateYear):2);
GoToRC(DRow[8],DCol[8]);
Write(RecordEntry.Price:3:2);
GoToRC(DRow[9],DCol[9]);
Write(RecordEntry.Tape);
GoToRC(DRow[10],DCol[10]);
Write(RecordEntry.RunTime:2:2);
PrintText(DRow[11],DCol[11],RecordEntry.Format);
GoToRC(DRow[12],DCol[12]);
Write(RecordEntry.Start);
GoToRC(DRow[13],DCol[13]);
Write(RecordEntry.Stop);
GoToRC(DRow[14],DCol[14]);
Write(RecordEntry.RunSpeed);
End;
Procedure UpdateParadoxInfo(UseInfo:Boolean);
Type
IType = Array[0..4] of Byte;
Const
PRow:Byte = 21;
PCol:IType = (8,29,43,61,74);
Var
NumRecs,CurrRec : RecordNumber;
NumFields,NKeys : Integer;
TableName : String;
Begin
NumRecs := 0;
CurrRec := 0;
NumFields := 0;
NKeys := 0;
TableName := 'None';
if (UseInfo) then
Begin
TableName := VLIBName+'.DB';
VLIBRet := VLIBTblNRecs(NumRecs);
VLIBRet := VLIBRecNFlds(NumFields);
VLIBRet := VLIBKeyNFlds(NKeys);
VLIBRet := VLIBRecNum(CurrRec);
End;
PrintText(PRow,PCol[0],' ');
PrintText(PRow,PCol[1],' ');
PrintText(PRow,PCol[2],' ');
PrintText(PRow,PCol[3],' ');
PrintText(PRow,PCol[4],' ');
PrintText(PRow,PCol[0],TableName);
GoToRC(PRow,PCol[1]);
Write(NumRecs);
GoToRC(PRow,PCol[2]);
Write(NumFields);
GoToRC(PRow,PCol[3]);
Write(NKeys);
GoToRC(PRow,PCol[4]);
Write(CurrRec);
End;
Function EditRec(var RecordEntry:VLIBTABLEENTRY; EditOnly:Boolean):Boolean;
Type
IType = Array[0..14] of Byte;
Const
ERow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
ECol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
ELen:IType = (40,5,55,30,15,15,10,10,7,5,7,8,7,7,10);
Var
Choice : String;
Code : Integer;
Begin
FillChar(RecordEntry,sizeof(RecordEntry),#0);
if (EditOnly) then
Begin
if (VLIBRecGet(RecordEntry) <> PXSUCCESS) then
Begin
EditRec := FALSE;
Exit;
End;
End
else
ClearRecord;
RecordEntry.Title := GetString(ERow[0],ECol[0],ELen[0],RecordEntry.Title,FALSE);
RecordEntry.Rating := GetString(ERow[1],ECol[1],ELen[1],RecordEntry.Rating,FALSE);
RecordEntry.Stars := GetString(ERow[2],ECol[2],ELen[2],RecordEntry.Stars,FALSE);
RecordEntry.Cast := GetString(ERow[3],ECol[3],ELen[3],RecordEntry.Cast,FALSE);
RecordEntry.Director := GetString(ERow[4],ECol[4],ELen[4],RecordEntry.Director,FALSE);
RecordEntry.Company := GetString(ERow[5],ECol[5],ELen[5],RecordEntry.Company,FALSE);
RecordEntry.Category := GetString(ERow[6],ECol[6],ELen[6],RecordEntry.Category,FALSE);
if (not EditOnly) then
PrintText(ERow[7],ECol[7],' / /');
if (EditOnly) then
Begin
Str(RecordEntry.DateMonth,Choice);
Choice := GetString(ERow[7],ECol[7],2,Choice,FALSE);
Val(Choice,RecordEntry.DateMonth,Code);
Str(RecordEntry.DateDay,Choice);
Choice := GetString(ERow[7],ECol[7]+3,2,Choice,FALSE);
Val(Choice,RecordEntry.DateDay,Code);
Str(RecordEntry.DateYear,Choice);
Choice := GetString(ERow[7],ECol[7]+6,4,Choice,FALSE);
Val(Choice,RecordEntry.DateYear,Code);
Str(RecordEntry.Price:3:2,Choice);
Choice := GetString(ERow[8],ECol[8],ELen[8],Choice,FALSE);
Val(Choice,RecordEntry.Price,Code);
Str(RecordEntry.Tape,Choice);
Choice := GetString(ERow[9],ECol[9],ELen[9],Choice,FALSE);
Val(Choice,RecordEntry.Tape,Code);
Str(RecordEntry.RunTime:3:2,Choice);
Choice := GetString(ERow[10],ECol[10],ELen[10],Choice,FALSE);
Val(Choice,RecordEntry.RunTime,Code);
End
else
Begin
Choice := GetString(ERow[7],ECol[7],2,Choice,FALSE);
Val(Choice,RecordEntry.DateMonth,Code);
Choice := GetString(ERow[7],ECol[7]+3,2,Choice,FALSE);
Val(Choice,RecordEntry.DateDay,Code);
Choice := GetString(ERow[7],ECol[7]+6,2,Choice,FALSE);
Val(Choice,RecordEntry.DateYear,Code);
Choice := GetString(ERow[8],ECol[8],ELen[8],Choice,FALSE);
Val(Choice,RecordEntry.Price,Code);
Choice := GetString(ERow[9],ECol[9],ELen[9],Choice,FALSE);
Val(Choice,RecordEntry.Tape,Code);
Choice := GetString(ERow[10],ECol[10],ELen[10],Choice,FALSE);
Val(Choice,RecordEntry.RunTime,Code);
End;
RecordEntry.Format := GetString(ERow[11],ECol[11],ELen[11],RecordEntry.Format,FALSE);
if (EditOnly) then
Begin
Str(RecordEntry.Start,Choice);
Choice := GetString(ERow[12],ECol[12],ELen[12],Choice,FALSE);
Val(Choice,RecordEntry.Start,Code);
Str(RecordEntry.Stop,Choice);
Choice := GetString(ERow[13],ECol[13],ELen[13],Choice,FALSE);
Val(Choice,RecordEntry.Stop,Code);
End
else
Begin
Choice := GetString(ERow[12],ECol[12],ELen[12],Choice,FALSE);
Val(Choice,RecordEntry.Start,Code);
Choice := GetString(ERow[13],ECol[13],ELen[13],Choice,FALSE);
Val(Choice,RecordEntry.Stop,COde);
End;
RecordEntry.RunSpeed := GetString(ERow[14],ECol[14],ELen[14],RecordEntry.RunSpeed,FALSE);
EditRec := TRUE;
End;
FUNCTION SrchRec(var RecordEntry:VLIBTABLEENTRY;KeyOrFld:Boolean):Boolean;
Type
IType = Array[0..14] of Byte;
SType = Array[0..14] of String;
Const
SRow:IType = (4,4,5,6,6,7,7,7,9,9,9,9,10,10,10);
SCol:IType = (15,74,15,15,60,15,45,68,15,32,53,70,14,33,53);
SLen:IType = (40,5,55,30,15,15,10,10,7,5,7,8,7,7,10);
FieldArray:Stype = (
'Title',
'Rating',
'Stars',
'Cast',
'Director',
'Company',
'Category',
'Date',
'Price',
'Tape',
'RunTime',
'Format',
'Start',
'Stop',
'RunSpeed'
);
Var
Field,NumFields,NKeys,Mode,Code:Integer;
Choice,ClrString : String;
Ret : Boolean;
Begin
Mode := SEARCHFIRST;
Ret := TRUE;
Fillchar(ClrString,sizeof(ClrString),' ');
ClrString[0] := #70;
ClearRecord;
if (VLIBRecNFlds(NumFields) <> PXSUCCESS) then
Begin
SrchRec := FALSE;
End;
if (VLIBKeyNFlds(NKeys) <> PXSUCCESS) then
Begin
SrchRec := FALSE;
End;
if (KeyOrFld) then
Begin
PrintText(24,6,'Number of keys to search on (1 or ');
GoToRC(24,40);
Write(NKeys,'):');
Choice := GetString(24,44,1,Choice,TRUE);
ClearMessageArea;
Val(Choice,Field,Code);
if ((Field < 1) or (Field > NKeys)) then
Begin
PrintText(24,6,'Invalid number of keys - Hit any Key');
Key := ReadKey;
PrintText(24,6,ClrString);
SrchRec := FALSE;
Exit;
End;
NumKeys := Field;
case Field of
2:
RecordEntry.Title := GetString(SRow[0],SCol[0],SLen[0],RecordEntry.Title,FALSE);
End;
RecordEntry.Category := GetString(SRow[6],SCol[6],SLen[6],RecordEntry.Category,FALSE);
End
else
Begin
if (not GotSrchFFirst) then
Begin
PrintText(24,6,'Field to search on (1 - ');
GoToRC(24,30);
Write(NumFields,'):');
Choice := GetString(24,34,2,Choice,TRUE);
ClearMessageArea;
Val(Choice,Field,Code);
if ((Field < 1) or (Field > NumFields)) then
Begin
GoToRC(24,6);
Write(Field);
PrintText(24,9,' is an invalid Field Number - Hit any Key');
Key := ReadKey;
PrintText(24,6,ClrString);
SrchRec := FALSE;
Exit;
End;
FieldNum:=Field;
End
else
Begin
Mode := SEARCHNEXT;
Field := FieldNum;
End;
{start main switch loop }
case Field of
1: Begin
if (not GotSrchFFirst) then
RecordEntry.Title := GetString(SRow[0],SCol[0],SLen[0],RecordEntry.Title,FALSE);
End;
2: Begin
if (not GotSrchFFirst) then
RecordEntry.Rating := GetString(SRow[1],SCol[1],SLen[1],RecordEntry.Rating,FALSE);
End;
3: Begin
if (not GotSrchFFirst) then
RecordEntry.Stars := GetString(SRow[2],SCol[2],SLen[2],RecordEntry.Stars,FALSE);
End;
4: Begin
if (not GotSrchFFirst) then
RecordEntry.Cast := GetString(SRow[3],SCol[3],SLen[3],RecordEntry.Cast,FALSE);
End;
5: Begin
if (not GotSrchFFirst) then
RecordEntry.Director := GetString(SRow[4],SCol[4],SLen[4],RecordEntry.Director,FALSE);
End;
6: Begin
if (not GotSrchFFirst) then
RecordEntry.Company := GetString(SRow[5],SCol[5],SLen[5],RecordEntry.Company,FALSE);
End;
7: Begin
if (not GotSrchFFirst) then
RecordEntry.Category := GetString(SRow[6],SCol[6],SLen[6],RecordEntry.Category,FALSE);
End;
8: Begin
if (not GotSrchFFirst) then
Begin
Choice := GetString(SRow[7],SCol[7],2,Choice,FALSE);
Val(Choice,RecordEntry.DateMonth,Code);
Choice := GetString(SRow[7],SCol[7]+3,2,Choice,FALSE);
Val(Choice,RecordEntry.DateDay,COde);
Choice := GetString(SRow[7],SCol[7]+6,2,Choice,FALSE);
Val(Choice,RecordEntry.DateYear,Code);
End;
End;
9: Begin
if (not GotSrchFFirst) then
Begin
Choice := GetString(SRow[8],SCol[8],SLen[8],Choice,FALSE);
Val(Choice,RecordEntry.Price,Code);
End;
End;
10: Begin
if (not GotSrchFFirst) then
Begin
Choice := GetString(SRow[9],SCol[9],SLen[9],Choice,FALSE);
Val(Choice,RecordEntry.Tape,Code);
End;
End;
11: Begin
if (not GotSrchFFirst) then
Begin
Choice := GetString(SRow[10],SCol[10],SLen[10],Choice,FALSE);
Val(Choice,RecordEntry.RunTime,COde);
End;
End;
12: Begin
if (not GotSrchFFirst) then
RecordEntry.Format := GetString(SRow[11],SCol[11],SLen[11],RecordEntry.Format,FALSE);
End;
13: Begin
if (not GotSrchFFirst) then
Begin
Choice := GetString(SRow[12],SCol[12],SLen[12],Choice,FALSE);
Val(Choice,RecordEntry.Start,Code);
End;
End;
14: Begin
if (not GotSrchFFirst) then
Begin
Choice := GetString(SRow[13],SCol[13],SLen[13],Choice,FALSE);
Val(Choice,RecordEntry.Stop,Code);
End;
End;
15: Begin
if (not GotSrchFFirst) then
RecordEntry.RunSpeed := GetString(SRow[14],SCol[14],SLen[14],RecordEntry.RunSpeed,FALSE);
End;
End; {case}
if (VLIBSrchFld(Mode,FieldArray[Field-1],RecordEntry) <> PXSUCCESS) then
Ret:=FALSE;
End;
SrchRec := Ret;
End;
FUNCTION AddRecord:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Begin
if (EditRec(RecordEntry,FALSE)) then
Begin
VLIBRet := VLIBRecInsert(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End;
End;
AddRecord := VLIBRet;
End;
FUNCTION CloseFile:INTEGER;
Begin
UpdateParadoxInfo(FALSE);
ClearRecord;
CloseFile := VLIBTblClose;
End;
FUNCTION DecryptFile:INTEGER;
Var
Choice : String;
IsProtected : Boolean;
Begin
VLIBRet := VLIBTblProtected(IsProtected);
if (VLIBRet = PXSUCCESS) then
Begin
if (IsProtected) then
Begin
PrintText(24,6,'Enter Password:');
Choice := GetString(24,23,15,Choice,FALSE);
ClearMessageArea;
VLIBRet := VLIBTblDecrypt(Choice);
DecryptFile := VLIBRet;
Exit;
End
else
VLIBRet := -1;
PrintText(24,6,'Table is not encrypted');
End;
DecryptFile := VLIBRet;
End;
FUNCTION DeleteRecord:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Choice : String;
Ret : Integer;
Begin
PrintText(24,6,'Delete Current Record (Y or N):');
Choice := GetString(24,38,1,Choice,TRUE);
ClearMessageArea;
VLIBRet := -1;
if (Choice[1] = 'Y') then
Begin
VLIBRet := VLIBRecDelete;
if (VLIBRet = PXSUCCESS) then
Begin
VLIBRet := VLIBRecGet(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End
else
Begin
if (VLIBRet = PXERR_TABLEEMPTY) then
Begin
ClearRecord;
UpdateParadoxInfo(TRUE);
End
End;
End;
End;
DeleteRecord := VLIBRet;
End;
FUNCTION DeleteFile:INTEGER;
Begin
UpdateParadoxInfo(FALSE);
ClearRecord;
DeleteFile := VLIBTblDelete;
End;
FUNCTION EditRecord:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Begin
VLIBRet := -1;
if (EditRec(RecordEntry,TRUE)) then
Begin
VLIBRet := VLIBRecUpdate(RecordEntry);
if (VLIBRet = PXSUCCESS) then
DisplayRecord(RecordEntry);
End;
EditRecord := VLIBRet;
End;
FUNCTION FirstRecord:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Begin
VLIBRet := VLIBRecFirst(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End;
FirstRecord:=VLIBRet;
End;
FUNCTION GotoRecord:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Choice : String;
Value : RecordNumber;
Code : Integer;
Begin
PrintText(24,6,'Goto record No:');
Choice := GetString(24,22,6,Choice,FALSE);
Val(Choice,Value,Code);
ClearMessageArea;
VLIBRet := VLIBRecGoto(Value);
if (VLIBRet = PXSUCCESS) then
Begin
VLIBRet := VLIBRecGet(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End;
End;
GotoRecord := VLIBRet;
End;
FUNCTION SearchKFirst:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Begin
FillChar(SearchRecord,sizeof(SearchRecord),#0);
GotSrchKFirst := FALSE;
VLIBRet := -1;
if (SrchRec(SearchRecord,TRUE)) then
begin
ClearMessageArea;
VLIBRet := VLIBSrchKey(SEARCHFIRST,NumKeys,SearchRecord);
if (VLIBRet = PXSUCCESS) then
Begin
VLIBRet := VLIBRecGet(RecordEntry);
if (VLIBRet = PXSUCCESS) then
begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
GotSrchKFirst := TRUE;
End;
End;
End;
SearchKFirst := VLIBRet;
End;
FUNCTION SearchKNext:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Begin
VLIBRet := -1;
if (GotSrchKFirst) then
Begin
VLIBRet := VLIBSrchKey(SEARCHNEXT,NumKeys,SearchRecord);
if (VLIBRet = PXSUCCESS) then
Begin
VLIBRet := VLIBRecGet(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End;
End;
End
else
PrintText(24,6,'No search key is set up, call Srch Key 1st');
SearchKNext := VLIBRet;
End;
FUNCTION LastRecord:INTEGER;
Var
RecordEntry : VLIBTABLEENTRY;
Begin
VLIBRet := VLIBRecLast(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End;
LastRecord := VLIBRet;
End;
FUNCTION MergeFile:INTEGER;
Var
Choice : String;
Begin
PrintText(24,6,'File to merge into ');
GoToRC(24,26);
Write(VLIBName,'.DB (No Extension):');
Choice := GetString(24,49,8,Choice,TRUE);
ClearMessageArea;
MergeFIle := VLIBTblAdd(Choice,DESTINATION);
End;
FUNCTION EncryptFile:INTEGER;
Var
Choice : String;
Begin
PrintText(24,6,'Enter Password:');
Choice := GetString(24,23,15,Choice,FALSE);
ClearMessageArea;
EncryptFile := VLIBTblEncrypt(Choice);
End;
FUNCTION NextRecord:INTEGER;
Var
RecordEntry : VLIBTABLEENTRY;
Begin
VLIBRet := VLIBRecNext(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End;
NextRecord:=VLIBRet;
End;
FUNCTION OpenFile:INTEGER;
Var
Choice,Value:String;
IsProtected:Boolean;
Begin
Value := NoPassword;
VLIBRet := VLIBTblProtected(IsProtected);
if (VLIBRet = PXSUCCESS) then
Begin
if (IsProtected) then
Begin
PrintText(24,6,'Enter Password:');
Choice := GetString(24,23,15,Choice,FALSE);
ClearMessageArea;
Value := Choice;
End
End
else
Begin
OpenFile := VLIBRet;
Exit;
End;
VLIBRet := VLIBTblOpen(Value);
if (VLIBRet = PXSUCCESS) then
OpenFile := FirstRecord;
OpenFile:=VLIBRet;
End;
FUNCTION CopyFile:INTEGER;
Var
Choice:String;
Begin
PrintText(24,6,'File to copy from (No extension):');
Choice := GetString(24,40,8,Choice,TRUE);
ClearMessageArea;
CopyFile := VLIBTblCopy(Choice,DESTINATION);
End;
FUNCTION PreviousRecord:INTEGER;
Var
RecordEntry : VLIBTABLEENTRY;
Begin
VLIBRet := VLIBRecPrev(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
End;
PreviousRecord := VLIBRet;
End;
FUNCTION RenameFile:INTEGER;
Var
Choice:String;
Begin
PrintText(24,6,'Rename ');
GoToRc(24,13);
Write(VLIBName,'.DB to (No extension):');
Choice := GetString(24,40,8,Choice,TRUE);
ClearMessageArea;
RenameFile := VLIBTblRename(Choice);
End;
FUNCTION SearchFFirst:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Begin
GotSrchFFirst := FALSE;
VLIbRet := -1;
FillChar(SearchRecord,sizeof(SearchRecord),#0);
if (SrchRec(SearchRecord,FALSE)) then
Begin
ClearMessageArea;
VLIBRet := VLIBRecGet(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
GotSrchFFirst := TRUE;
End;
End;
SearchFFirst := VLIBRet;
End;
FUNCTION SearchFNext:INTEGER;
Var
RecordEntry:VLIBTABLEENTRY;
Begin
VLIBRet := -1;
if (GotSrchFFirst) then
Begin
if (SrchRec(SearchRecord,FALSE)) then
Begin
ClearMessageArea;
VLIBRet := VLIBRecGet(RecordEntry);
if (VLIBRet = PXSUCCESS) then
Begin
DisplayRecord(RecordEntry);
UpdateParadoxInfo(TRUE);
GotSrchFFirst := TRUE;
End;
End;
End
else
PrintText(24,6,'No search field is set up, call Srch Field 1st');
SearchFNext := VLIBRet;
End;
FUNCTION CreateFile:INTEGER;
Var
Choice : String;
Begin
VLIBRet := -1;
PrintText(24,6,'Over Write ');
GoToRC(24,17);
Write(VLIBName,'.DB (Y or N):');
Choice := GetString(24,35,1,Choice,TRUE);
ClearMessageArea;
if (Choice[1] = 'Y') then
CreateFile := VLIBTblCreate(64);
CreateFile := VLIBRet;
End;
FUNCTION EmptyFil:INTEGER;
Begin
ClearRecord;
EmptyFil := VLIBTblEmpty;
End;
FUNCTION ValidEvent(Choice: String):Boolean;
CONST
NumFunctions = 21;
EventArray : Array[0..NumFunctions] of Process = (
(ITem : 'AR';Message : 'Record Add Successful'),
(Item : 'CT';Message : 'Table Close Successful'),
(Item : 'DT';Message : 'Table Decrypt Successful'),
(Item : 'DR';Message : 'Record Delete Successful'),
(Item : 'ET';Message : 'Table Delete Successful'),
(Item : 'ER';Message : 'Record Update Successful'),
(Item : 'FR';Message : 'First Record Successful'),
(Item : 'GR';Message : 'Goto Record Successful'),
(Item : 'KF';Message : 'Search Key 1st Successful'),
(Item : 'KN';Message : 'Search Key Next Successful'),
(Item : 'LR';Message : 'Last Record Successful'),
(Item : 'MT';Message : 'Table Merge Successful'),
(Item : 'NT';Message : 'Table Encrypt Successful'),
(Item : 'NR';Message : 'Next Record Successful'),
(Item : 'OT';Message : 'Table Open Successful'),
(Item : 'PT';Message : 'Table Copy Successful'),
(Item : 'PR';Message : 'Prev Record Successful'),
(Item : 'RT';Message : 'Table Rename Successful'),
(Item : 'SF';Message : 'Search Field 1st Successful'),
(Item : 'SN';Message : 'Search Field Next Successful'),
(Item : 'TT';Message : 'Table Create Successful'),
(Item : 'YT';Message : 'Table Empty Successful')
);
VAR
DoProcess,Finished : Boolean;
Index,Ret : Integer;
Key : Char;
Spaces : String;
Begin
FillChar(SPaces,sizeof(String),' ');
Spaces[0] := #70;
DoProcess := FALSE;
Ret := 1;
Finished := FALSE;
Index := 0;
(* Set up PASCAL Function pointers - these function references can
not be added to CONST declaration above because they are not
allowed, the compiler will object with an error. Please notice
the {$F+} directive before the DisplayFields procedure. This
enables FAR calls and enables this program to use the Function
pointers declared below...................................... *)
EventArray[0].Fptr := AddRecord;
EventArray[1].Fptr := CloseFile;
EventArray[2].Fptr := DecryptFile;
EventArray[3].Fptr := DeleteRecord;
EventArray[4].Fptr := DeleteFile;
EventArray[5].Fptr := EditRecord;
EventArray[6].Fptr := FirstRecord;
EventArray[7].Fptr := GotoRecord;
EventArray[8].Fptr := SearchKFirst;
EventArray[9].Fptr := SearchKNext;
EventArray[10].Fptr := LastRecord;
EventArray[11].Fptr := MergeFile;
EventArray[12].Fptr := EncryptFile;
EventArray[13].Fptr := NextRecord;
EventArray[14].Fptr := OpenFile;
EventArray[15].Fptr := CopyFile;
EventArray[16].Fptr := PreviousRecord;
EventArray[17].Fptr := RenameFile;
EventArray[18].Fptr := SearchFFirst;
EventArray[19].Fptr := SearchFNext;
EventArray[20].Fptr := CreateFile;
EventArray[21].Fptr := EmptyFil;
if (Choice = 'QU') then
ValidEvent := FALSE
else
Begin
Repeat
begin
if (Choice = EventArray[Index].Item) then
begin
DoProcess := TRUE;
Finished := TRUE;
end
else
Index := Index +1;
end;
Until ((Index > NumFunctions) or Finished);
if (DoProcess) then
Begin
Ret := EventArray[Index].Fptr;
if (Ret = 0) then
PrintText(24,6,EventArray[Index].Message)
else
Ret := VLIBError1(Ret);
End
else
Begin
GoToRc(24,6);
Write(Choice,' is an invalid option - Hit any Key');
Key := ReadKey;
PrintText(24,6,Spaces);
End;
End;
End;
(*----------------------------------------------------------------
MAIN PROGRAM
-----------------------------------------------------------------*)
Begin
if (OpeningScreen) then
Begin
Repeat
Choice := GetString(18,68,2,Choice,TRUE);
ClearMessageArea;
Until not (ValidEvent(Choice));
VLIBRet := PXExit;
if (VLIBRet <> PXSUCCESS) then
VlibRet := VLIBError1(VlibRet);
End;
ClearArea(1,1,25,80);
End.